Gigarom 1/Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso/FILES/DEV/A-B/001. Sample.cpt/Sample.p

Text File | 1988-08-02 | 23KB | 705 lines

{------------------------------------------------------------------------------
#
#    Apple Macintosh Developer Technical Support
#
#    MultiFinder-Aware Simple Sample Application
#
#    Sample
#
#    Sample.p    -    Pascal Source
#
#    Copyright © 1988 Apple Computer, Inc.
#    All rights reserved.
#
#    Versions:    1.0                    8/88
#
#    Components:    Sample.p            August 1, 1988
#                Sample.c            August 1, 1988
#                Sample.r            August 1, 1988
#                Sample.h            August 1, 1988
#                PSample.make        August 1, 1988
#                CSample.make        August 1, 1988
#
#    Sample is an example application that demonstrates how to
#    initialize the commonly used toolbox managers, operate
#    successfully under MultiFinder, handle desk accessories,
#    and create, grow, and zoom windows.
#
#    It does not by any means demonstrate all the techniques
#    you need for a large application. In particular, Sample
#    does not cover exception handling, multiple windows/documents,
#    sophisticated memory management, printing, or undo. All of
#    these are vital parts of a normal full-sized application.
#
#    This application is an example of the form of a Macintosh
#    application; it is NOT a template. It is NOT intended to be
#    used as a foundation for the next world-class, best-selling,
#    600K application. A stick figure drawing of the human body may
#    be a good example of the form for a painting, but that does not
#    mean it should be used as the basis for the next Mona Lisa.
#
#    We recommend that you review this program or TESample before
#    beginning a new application.
#
------------------------------------------------------------------------------}


PROGRAM Sample;


{Segmentation strategy:

 This program consists of three segments. Main contains most of the code,
 including the MPW libraries, and the main program. Initialize contains
 code that is only used once, during startup, and can be unloaded after the
 program starts. %A5Init is automatically created by the Linker to initialize
 globals for the MPW libraries and is unloaded right away.}


{SetPort strategy:

 Toolbox routines do not change the current port. In spite of this, in this
 program we use a strategy of calling SetPort whenever we want to draw or
 make calls which depend on the current port. This makes us less vulnerable
 to bugs in other software which might alter the current port (such as the
 bug (feature?) in many desk accessories which change the port on OpenDeskAcc).
 Hopefully, this also makes the routines from this program more self-contained,
 since they don't depend on the current port setting.}


USES
    MemTypes, QuickDraw, OSIntf, ToolIntf;

CONST
    {MPW 3.0 will include a Traps.p interface file that includes constants for trap numbers.
     These constants are from that file.}
    _WaitNextEvent            = $A860;
    _Unimplemented            = $A89F;

    {SysEnvironsVersion is passed to SysEnvirons to tell it which version of the
     SysEnvRec we understand.}
    sysEnvironsVersion        = 1;

    {OSEvent is the event number of the suspend/resume and mouse-moved events sent
     by MultiFinder. Once we determine that an event is an osEvent, we look at the
     high byte of the message sent to determine which kind it is. To differentiate
     suspend and resume events we check the resumeMask bit.}
    osEvent                    = app4Evt;    {event used by MultiFinder}
    suspendResumeMessage    = 1;        {high byte of suspend/resume event message}
    resumeMask                = 1;        {bit of message field for resume vs. suspend}
    mouseMovedMessage        = $FA;        {high byte of mouse-moved event message}

    {This is the minimum size (in K) for the application to run.}
    kMinSize    = 22;

    {ExtremeNeg and ExtremePos are used to set up wide open rectangles and regions.}
    extremeNeg    = -32768;
    extremePos    = 32767 - 1;            {required for old region bug}

    {The following constants are all resource IDs, corresponding to resources in Sample.r.}
    rMenuBar    = 128;                    {application's menu bar}
    rAboutAlert    = 128;                    {about alert}
    rWindow        = 128;                    {application's window}
    rStopRect    = 128;                    {rectangle for Stop light}
    rGoRect        = 129;                    {rectangle for Go light}

    {The following constants are used to identify menus and their items. The menu IDs
     have an "m" prefix and the item numbers within each menu have an "i" prefix.}
    mApple        = 128;                    {Apple menu}
    iAbout        = 1;

    mFile        = 129;                    {File menu}
    iNew        = 1;
    iClose        = 4;
    iQuit        = 12;

    mEdit        = 130;                    {Edit menu}
    iUndo        = 1;
    iCut        = 3;
    iCopy        = 4;
    iPaste        = 5;
    iClear        = 6;

    mLight        = 131;                    {Light menu}
    iStop        = 1;
    iGo            = 2;


VAR
    {The "g" prefix is used to emphasize that a variable is global.}

    {GMac is used to hold the result of a SysEnvirons call. This makes
     it convenient for any routine to check the environment.}
    gMac                : SysEnvRec;    {set up by Initialize}

    {GHasWaitNextEvent is set at startup, and tells whether the WaitNextEvent
     trap is available. If it is false, we know that we must call GetNextEvent.}
    gHasWaitNextEvent    : BOOLEAN;        {set up by Initialize}

    {GInBackground is maintained by our osEvent handling routines. Any part of
     the program can check it to find out if it is currently in the background.}
    gInBackground        : BOOLEAN;        {maintained by Initialize and DoEvent}

    {GGrowRect is a rectangle representing the grow/shrink limits for GrowWindow.}
    gGrowRect            : Rect;            {set up by Initialize}


    {The following globals are the state of the window. If we supported more than
     one window, they would be attatched to each document, rather than globals.}

    {GStopped tells whether the stop light is currently on stop or go.}
    gStopped            : BOOLEAN;        {maintained by Initialize and SetLight}

    {GStopRect and gGoRect are the rectangles of the two stop lights in the window.}
    gStopRect            : Rect;            {set up by Initialize}
    gGoRect                : Rect;            {set up by Initialize}


{$S Initialize}
FUNCTION TrapAvailable(tNumber: INTEGER; tType: TrapType): BOOLEAN;

{Check to see if a given trap is implemented. This is only used by the
 Initialize routine in this program, so we put it in the Initialize segment.
 The recommended approach to see if a trap is implemented is to see if
 the address of the trap routine is the same as the address of the
 Unimplemented trap.}

BEGIN
    {Check and see if the trap exists. On 64K ROM machines, tType will be ignored.}

    TrapAvailable := NGetTrapAddress(tNumber, tType) <> GetTrapAddress(_Unimplemented);
END; {TrapAvailable}


{$S Main}
FUNCTION IsDAWindow(window: WindowPtr): BOOLEAN;

{Check if a window belongs to a desk accessory.}

BEGIN
    IF window = NIL THEN
        IsDAWindow := FALSE
    ELSE    {DA windows have negative windowKinds}
        IsDAWindow := WindowPeek(window)^.windowKind < 0;
END; {IsDAWindow}


{$S Main}
FUNCTION IsAppWindow(window: WindowPtr): BOOLEAN;

{Check to see if a window belongs to the application. If the window pointer
 passed was NIL, then it could not be an application window. WindowKinds
 that are negative belong to the system and windowKinds less than userKind
 are reserved by Apple except for windowKinds equal to dialogKind, which
 mean it is a dialog.}

BEGIN
    IF window = NIL THEN
        IsAppWindow := FALSE
    ELSE    {application windows have windowKinds >= userKind (8) or dialogKind (2)}
        WITH WindowPeek(window)^ DO
            IsAppWindow := (windowKind >= userKind) | (windowKind = dialogKind);
END; {IsAppWindow}


{$S Main}
PROCEDURE DoCloseWindow(window: WindowPtr);

{Close a window. This handles only desk accessory windows because we do not
 allow our window to be closed. TESample provides an example of how to handle
 the closing of application windows.}

BEGIN
    IF IsDAWindow(window) THEN
        CloseDeskAcc(WindowPeek(window)^.windowKind);
END; {DoCloseWindow}


{$S Main}
PROCEDURE ForceEnvirons;

{Make sure that the machine has at least 128K ROMs and enough memory to run.
 If it doesn't, exit. SysEnvirons can be called before the toolbox managers
 are initialized, and we need to call it at this point so we can check for
 the right ROMs and memory availability before we call MaxApplZone and
 initialize the toolbox managers. If AppleTalk has not been initialized, you
 won't get the version of the AppleTalk driver that is running. That is not
 critical here, and if that information was required, SysEnvirons could be
 called again after AppleTalk had been initialized.}

VAR
    ignoreError    : OSErr;
BEGIN
    {ignore the error returned from SysEnvirons; even if an error occurred,
     the SysEnvirons glue will fill in the SysEnvRec}
    ignoreError := SysEnvirons(sysEnvironsVersion, gMac);
    IF (gMac.machineType < 0) |
        (StackSpace + ORD(GetApplLimit) - ORD(ApplicZone) < kMinSize * 1024) THEN
        ExitToShell;
    {if you have stack requirements that differ from the default,
    then you could use SetApplLimit to increase StackSpace at this point.}
END; {ForceEnvirons}


{$S Initialize}
PROCEDURE GoGetRect(rectID: INTEGER; VAR theRect: Rect);

{This utility loads the global rectangles that are used by the window
 drawing routines. It shows how the resource manager can be used to hold
 values in a convenient manner. These values are then easily altered without
 having to re-compile the source code. In this particular case, we know
 that this routine is being called at initialization time. Therefore,
 if a failure occurs here, we will assume that the application is in such
 bad shape that we should just exit. Your error handling may differ, but
 the check should still be made.}

TYPE
    RectPtr        = ^Rect;
    RectHnd        = ^RectPtr;
VAR
    resource    : Handle;
BEGIN
    resource := GetResource('RECT', rectID);
    IF resource = NIL THEN ExitToShell;
    theRect := RectHnd(resource)^^;
END; {GoGetRect}


{$S Initialize}
PROCEDURE Initialize;

{Set up the whole world, including global variables, Toolbox managers,
 and menus. We also create our one application window at this time.
 Since window storage is non-relocateable, how and when to allocate space
 for windows is very important so that heap fragmentation does not occur.
 Because Sample has only one window and it is only disposed when the application
 quits, we will allocate its space here, before anything that might be a locked
 relocatable object gets into the heap. This way, we can force its storage to be
 in the lowest memory available in the heap. Window storage can differ widely
 amongst applications depending on how many windows are created and disposed.
 If a failure occurs here, we will consider that the application is in such
 bad shape that we should just exit. Your error handling may differ, but
 the checks should still be made.}

VAR
    menuBar        : Handle;
    window        : WindowPtr;

BEGIN
    gHasWaitNextEvent := TrapAvailable(_WaitNextEvent, ToolTrap);
    gInBackground := FALSE;

    InitGraf(@thePort);
    InitFonts;
    InitWindows;
    InitMenus;
    TEInit;
    InitDialogs(NIL);
    InitCursor;

{    we will allocate our own window storage instead of letting the Window
    Manager do it because GetNewWindow may load in temp. resources before
    making the NewPtr call, and this can lead to heap fragmentation. }
    window := WindowPtr(NewPtr(SIZEOF(WindowRecord)));
    IF window = NIL THEN ExitToShell;
    window := GetNewWindow(rWindow, Ptr(window), WindowPtr(-1));

    menuBar := GetNewMBar(rMenuBar);        {read menus into menu bar}
    IF menuBar = NIL THEN ExitToShell;
    SetMenuBar(menuBar);                    {install menus}
    DisposHandle(menuBar);
    AddResMenu(GetMHandle(mApple), 'DRVR');    {add DA names to Apple menu}
    DrawMenuBar;

    gStopped := TRUE;
    GoGetRect(rStopRect, gStopRect);        {the stop light rectangle}
    GoGetRect(rGoRect, gGoRect);            {the go light rectangle}
END; {Initialize}


{$S Main}
PROCEDURE DoCloseBehind(window: WindowPtr);

{Close the window that is passed and all windows behind it.
 This closes windows from back to front, by calling itself
 recursively, which minimizes window updating. Always keep
 in mind the dangers of stack overflow when recursive routines
 are used in situations where the calling level gets too
 deep. That is not a problem here.}

BEGIN
    IF window <> NIL THEN BEGIN    {if we are passed a window, close other windows behind it first}
        DoCloseBehind(WindowPtr(WindowPeek(window)^.nextWindow));
        DoCloseWindow(window);    {now that all the windows behind are closed, close this one}
    END;
END; {DoCloseBehind}


{$S Main}
PROCEDURE Terminate;

{Clean up the application and exits. We close all of the windows so that
 they can update their documents, if any.}

BEGIN
    DoCloseBehind(FrontWindow);    {close all windows}
    ExitToShell;
END; {Terminate}


{$S Main}
PROCEDURE SetLight(window: WindowPtr; newStopped: BOOLEAN);

{Change the setting of the light.}

BEGIN
    IF newStopped <> gStopped THEN BEGIN
        gStopped := newStopped;
        SetPort(window);
        InvalRect(window^.portRect);
    END;
END; {SetLight}


{$S Main}
PROCEDURE AdjustMenus;

{Enable and disable menus based on the current state.
 The user can only select enabled menu items. We set up all the menu items
 before calling MenuSelect or MenuKey, since these are the only times that
 a menu item can be selected. Note that MenuSelect is also the only time
 the user will see menu items. This approach to deciding what enable/
 disable state a menu item has the advantage of concentrating all the decision-
 making in one routine, as opposed to being spread throughout the application.
 Other application designs may take a different approach that is just as valid.}

VAR
    window            : WindowPtr;
    menu            : MenuHandle;

BEGIN
    window := FrontWindow;

    menu := GetMHandle(mFile);
    IF IsDAWindow(window) THEN                {we can allow desk accessories to be closed from the menu}
        EnableItem(menu, iClose)
    ELSE
        DisableItem(menu, iClose);            {but not our traffic light window}

    menu := GetMHandle(mEdit);
    IF IsDAWindow(window) THEN BEGIN        {a desk accessory might need the edit menu}
        EnableItem(menu, iUndo);
        EnableItem(menu, iCut);
        EnableItem(menu, iCopy);
        EnableItem(menu, iPaste);
        EnableItem(menu, iClear);
    END ELSE BEGIN                            {but we know we do not}
        DisableItem(menu, iUndo);
        DisableItem(menu, iCut);
        DisableItem(menu, iCopy);
        DisableItem(menu, iClear);
        DisableItem(menu, iPaste);
    END;

    menu := GetMHandle(mLight);
    IF IsAppWindow(window) THEN BEGIN        {we know that it must be the traffic light}
        EnableItem(menu, iStop);
        EnableItem(menu, iGo);
    END ELSE BEGIN
        DisableItem(menu, iStop);
        DisableItem(menu, iGo);
    END;
    CheckItem(menu, iStop, gStopped);        {we can also determine check/uncheck state, too}
    CheckItem(menu, iGo, NOT gStopped);
END; {AdjustMenus}


{$S Main}
PROCEDURE DoMenuCommand(menuResult: LONGINT);

{This is called when an item is chosen from the menu bar (after calling
 MenuSelect or MenuKey). It performs the right operation for each command.
 It is good to have both the result of MenuSelect and MenuKey go to
 one routine like this to keep everything organized.}

VAR
    menuID            : INTEGER;        {the resource ID of the selected menu}
    menuItem        : INTEGER;        {the item number of the selected menu}
    itemHit            : INTEGER;
    daName            : Str255;
    daRefNum        : INTEGER;
    handledByDA        : BOOLEAN;

BEGIN
    menuID := HiWrd(menuResult);    {use built-ins (for efficiency)...}
    menuItem := LoWrd(menuResult);    {to get menu item number and menu number}
    CASE menuID OF
        mApple:
            CASE menuItem OF
                iAbout:                {bring up alert for About}
                    itemHit := Alert(rAboutAlert, NIL);
                OTHERWISE BEGIN        {all non-About items in this menu are DAs}
                    GetItem(GetMHandle(mApple), menuItem, daName);
                    daRefNum := OpenDeskAcc(daName);
                END;
            END;
        mFile:
            CASE menuItem OF
                iClose:
                    DoCloseWindow(FrontWindow);
                iQuit:
                    Terminate;
            END;
        mEdit:                        {call SystemEdit for DA editing & MultiFinder}
            handledByDA := SystemEdit(menuItem-1);    {since we don't do any editing}
        mLight:
            CASE menuItem OF
                iStop:
                    SetLight(FrontWindow, TRUE);
                iGo:
                    SetLight(FrontWindow, FALSE);
            END;
    END;
    HiliteMenu(0);                    {unhighlight what MenuSelect (or MenuKey) hilited}
END; {DoMenuCommand}


{$S Main}
PROCEDURE DrawWindow(window: WindowPtr);

{Draw the contents of the application window. We do some drawing in color, using
 Classic QuickDraw's color capabilities. This will be black and white on old
 machines, but color on color machines. At this point, the window's visRgn is
 set to allow drawing only where it needs to be done.}

BEGIN
    SetPort(window);

    EraseRect(window^.portRect);    {clear out any garbage that might be left behind}
    IF gStopped THEN                {draw a red (or white) stop light}
        ForeColor(redColor)
    ELSE
        ForeColor(whiteColor);
    PaintOval(gStopRect);
    ForeColor(blackColor);
    FrameOval(gStopRect);
    IF NOT gStopped THEN            {draw a green (or white) go light}
        ForeColor(greenColor)
    ELSE
        ForeColor(whiteColor);
    PaintOval(gGoRect);
    ForeColor(blackColor);
    FrameOval(gGoRect);
END; {DrawWindow}


{$S Main}
PROCEDURE DoContentClick(window: WindowPtr; event: EventRecord);

{This is called when a mouse-down event occurs in the content of a window.
 Other applications might want to call FindControl, TEClick, etc., to
 further process the click.}

BEGIN
    SetLight(window, NOT gStopped);
END; {DoContentClick}


{$S Main}
PROCEDURE DoUpdate(window: WindowPtr);

{This is called when an update event is received for a window.
 It calls DrawWindow to draw the contents of an application window.
 As an effeciency measure that does not have to be followed, it
 calls the drawing routine only if the visRgn is non-empty. This
 will handle situations where calculations for drawing or drawing
 itself is very time-consuming.}

BEGIN
    IF IsAppWindow(window) THEN BEGIN
        BeginUpdate(window);                    {this sets up the visRgn}
        IF NOT EmptyRgn(window^.visRgn) THEN    {draw if updating needs to be done}
            DrawWindow(window);
        EndUpdate(window);
    END;
END; {DoUpdate}


{$S Main}
PROCEDURE DoActivate(window: WindowPtr; becomingActive: BOOLEAN);

{This is called when a window is activated or deactivated.
 In Sample, the Window Manager's handling of activate and
 deactivate events is sufficient. Other applications may have
 TextEdit records, controls, lists, etc., to activate/deactivate.}

BEGIN
    IF IsAppWindow(window) THEN
        IF becomingActive THEN
            {do whatever you need to at activation}
        ELSE
            {do whatever you need to at deactivation};
END; {DoActivate}


{$S Main}
PROCEDURE AdjustCursor(mouse: Point; region: RgnHandle);

{Change the cursor's shape, depending on its position. This also calculates the region
 where the current cursor resides (for WaitNextEvent). If the mouse is ever outside of
 that region, an event would be generated, causing this routine to be called,
 allowing us to change the region to the region the mouse is currently in. If
 there is more to the event than just “the mouse moved”, we get called before the
 event is processed to make sure the cursor is the right one. In any (ahem) event,
 this is called again before we fall back into WNE.}

VAR
    window                : WindowPtr;
    arrowRgn            : RgnHandle;
    plusRgn                : RgnHandle;
    globalPortRect        : Rect;

BEGIN
    window := FrontWindow;    {we only adjust the cursor when we are in front}
    IF (NOT gInBackground) AND (NOT IsDAWindow(window)) THEN BEGIN
        {calculate regions for different cursor shapes}
        arrowRgn := NewRgn;
        plusRgn := NewRgn;

        {start with a big, big rectangular region}
        SetRectRgn(arrowRgn, extremeNeg, extremeNeg, extremePos, extremePos);

        {calculate plusRgn}
        IF IsAppWindow(window) THEN BEGIN
            SetPort(window);            {make a global version of the portRect}
            SetOrigin(-window^.portBits.bounds.left, -window^.portBits.bounds.top);
            globalPortRect := window^.portRect;
            RectRgn(plusRgn, globalPortRect);
            SectRgn(plusRgn, window^.visRgn, plusRgn);
            SetOrigin(0, 0);
        END;

        {subtract other regions from arrowRgn}
        DiffRgn(arrowRgn, plusRgn, arrowRgn);

        {change the cursor and the region parameter}
        IF PtInRgn(mouse, plusRgn) THEN BEGIN
            SetCursor(GetCursor(plusCursor)^^);
            CopyRgn(plusRgn, region);
        END ELSE BEGIN
            SetCursor(arrow);
            CopyRgn(arrowRgn, region);
        END;

        {get rid of our local regions}
        DisposeRgn(arrowRgn);
        DisposeRgn(plusRgn);
    END;
END; {AdjustCursor}


{$S Main}
PROCEDURE DoEvent(event: EventRecord);

{Do the right thing for an event. Determine what kind of event it is, and call
 the appropriate routines.}

VAR
    part    : INTEGER;
    window    : WindowPtr;
    hit        : BOOLEAN;
    key        : CHAR;

BEGIN
    CASE event.what OF
        mouseDown: BEGIN
            part := FindWindow(event.where, window);
            CASE part OF
                inMenuBar: BEGIN            {process the menu command}
                    AdjustMenus;
                    DoMenuCommand(MenuSelect(event.where));
                END;
                inSysWindow:                {let the system handle the mouseDown}
                    SystemClick(event, window);
                inContent:
                    IF window <> FrontWindow THEN BEGIN
                        SelectWindow(window);
                        {DoEvent(event);}    {use this line for "do first click"}
                    END ELSE
                        DoContentClick(window, event);
                inDrag:                        {pass screenBits.bounds to get all gDevices}
                    DragWindow(window, event.where, screenBits.bounds);
                inGrow:;
                inZoomIn, inZoomOut:;
            END;
        END;
        keyDown, autoKey: BEGIN                {check for menukey equivalents}
            key := CHR(BAnd(event.message, charCodeMask));
            IF BAnd(event.modifiers, cmdKey) <> 0 THEN    {Command key down}
                IF event.what = keyDown THEN BEGIN
                    AdjustMenus;            {enable/disable/check menu items properly}
                    DoMenuCommand(MenuKey(key));
                END;
        END;                                {call DoActivate with the window and...}
        activateEvt:                        {TRUE for activate, FALSE for deactivate}
            DoActivate(WindowPtr(event.message), BAnd(event.modifiers, activeFlag) <> 0);
        updateEvt:                          {call DoUpdate with the window to update}
            DoUpdate(WindowPtr(event.message));
        osEvent:
            CASE BSR(event.message, 24) OF    {high byte of message}
                suspendResumeMessage: BEGIN
                    gInBackground := BAnd(event.message, resumeMask) = 0;
                    DoActivate(FrontWindow, NOT gInBackground);
                END;
            END;
    END;
END; {DoEvent}


{$S Main}
PROCEDURE EventLoop;

{Get events forever, and handle them by calling DoEvent.
 Get the events by calling WaitNextEvent, if it's available, otherwise
 by calling GetNextEvent. Also call AdjustCursor each time through the loop.}

VAR
    cursorRgn    : RgnHandle;
    gotEvent    : BOOLEAN;
    event        : EventRecord;

BEGIN
    cursorRgn := NewRgn;            {we’ll pass WNE an empty region the 1st time thru}
    REPEAT
        IF gHasWaitNextEvent THEN    {put us 'asleep' forever under MultiFinder}
            gotEvent := WaitNextEvent(everyEvent, event, MAXLONGINT, cursorRgn)
        ELSE BEGIN
            SystemTask;                {must be called if using GetNextEvent}
            gotEvent := GetNextEvent(everyEvent, event);
        END;
        IF gotEvent THEN BEGIN
            AdjustCursor(event.where, cursorRgn); {make sure we have the right cursor}
            DoEvent(event);
        END;
        AdjustCursor(event.where, cursorRgn);
    UNTIL FALSE;                    {loop forever; we quit through an ExitToShell}
END; {EventLoop}


PROCEDURE _DataInit; EXTERNAL;

{This routine is part of the MPW runtime library. This external
 reference to it is done so that we can unload its segment, %A5Init.}

{$S Main}
BEGIN
    UnloadSeg(@_DataInit);    {note that _DataInit must not be in Main!}
    ForceEnvirons;            {check for some basic requirements; exits if not met}
    MaxApplZone;            {expand the heap so code segments load at the top}

    Initialize;                {initialize the program}
    UnloadSeg(@Initialize);    {note that Initialize must not be in Main!}

    EventLoop;                {call the main event loop}
END.